모형과 데이터 불러오기
데이터와 기계학습 예측모형을 불러오자
library(tidyverse)
titanic_list <-
read_rds("data/titanic_list.rds")
str(titanic_list, max.level = 2) List of 2
$ data :List of 3
..$ training: tibble[,9] [2,099 × 9] (S3: tbl_df/tbl/data.frame)
.. ..- attr(*, "na.action")= 'omit' Named int [1:108] 46 90 118 119 122 132 139 145 151 152 ...
.. .. ..- attr(*, "names")= chr [1:108] "46" "90" "118" "119" ...
..$ henry : tibble[,7] [1 × 7] (S3: tbl_df/tbl/data.frame)
..$ johnny_d: tibble[,7] [1 × 7] (S3: tbl_df/tbl/data.frame)
$ model:List of 4
..$ titanic_lmr:List of 24
.. ..- attr(*, "class")= chr [1:3] "lrm" "rms" "glm"
..$ titanic_rf :List of 19
.. ..- attr(*, "class")= chr [1:2] "randomForest.formula" "randomForest"
..$ titanic_gbm:List of 27
.. ..- attr(*, "class")= chr "gbm"
..$ titanic_svm:List of 30
.. ..- attr(*, "class")= chr [1:2] "svm.formula" "svm"1 관측점 설명
관측점(instance) 별로 기계가 학습한 모형을 설명을 하는 방식은 다음과 같다.
- 분해(Break-down) 그래프: 예측에 대한 주요 변수별 기여분을 시각화.
library(tidyverse)
library(DALEX)
library(DALEXtra)
library(randomForest)
explainer_rf <- explain(titanic_list$model$titanic_rf,
data = titanic_list$data$training %>% select(-survived),
y = titanic_list$data$training %>% select(survived))Preparation of a new explainer is initiated
-> model label : randomForest ( [33m default [39m )
-> data : 2099 rows 8 cols
-> data : tibble converted into a data.frame
-> target variable : Argument 'y' was a data frame. Converted to a vector. ( [31m WARNING [39m )
-> target variable : 2099 values
-> predict function : yhat.randomForest will be used ( [33m default [39m )
-> predicted values : No value for predict function target column. ( [33m default [39m )
-> model_info : package randomForest , ver. 4.6.14 , task classification ( [33m default [39m )
-> model_info : Model info detected classification task but 'y' is a factor . ( [31m WARNING [39m )
-> model_info : By deafult classification tasks supports only numercical 'y' parameter.
-> model_info : Consider changing to numerical vector with 0 and 1 values.
-> model_info : Otherwise I will not be able to calculate residuals or loss function.
-> predicted values : numerical, min = 0 , mean = 0.2384393 , max = 1
-> residual function : difference between y and yhat ( [33m default [39m )
-> residuals : numerical, min = NA , mean = NA , max = NA
[32m A new explainer has been created! [39m 2 변수별 기여 분해 그래프
특정 관측점에 대한 변수별 기여를 분해하여 시각적으로 이해하기 쉽게 표현함.
2.1 헨리(henry)
2.1.1 표
library(reactable)
bd_rf <- predict_parts(explainer = explainer_rf,
new_observation = titanic_list$data$henry,
type = "break_down")
bd_rf %>%
select(-label) %>%
reactable::reactable(columns = list(
contribution = colDef(format = colFormat(digits = 2)),
cumulative = colDef(format = colFormat(digits = 2))
))2.1.2 분해 그래프
bd_rf %>%
plot()
2.1.3 다른 탑승객과 비교
바이올린 그래프가 그려져야하는데… 이론상… 하지만 그렇게 구현되지 않음!!! DALEX 버전 1.x 버전에서 생겼던 문제로 최신 버전 2.2.0으로 올리게 되면 문제 없음.
bd_rf_distr <- predict_parts(explainer = explainer_rf,
new_observation = titanic_list$data$henry,
type = "break_down",
order = c("age", "class", "fare", "gender", "embarked", "sibsp", "parch"),
keep_distributions = TRUE)
plot(bd_rf_distr, plot_distributions = TRUE) 
2.2 쟈니(johnny)
2.2.1 표
library(reactable)
bd_johnny_rf <- predict_parts(explainer = explainer_rf,
new_observation = titanic_list$data$johnny_d,
type = "break_down")
bd_johnny_rf %>%
select(-label) %>%
reactable::reactable(columns = list(
contribution = colDef(format = colFormat(digits = 2)),
cumulative = colDef(format = colFormat(digits = 2))
))2.2.2 분해 그래프
bd_johnny_rf %>%
plot()
2.2.3 다른 탑승객과 비교
바이올린 그래프가 그려져야하는데… 이론상… 하지만 그렇게 구현되지 않음!!!
bd_rf_johnny_distr <- predict_parts(explainer = explainer_rf,
new_observation = titanic_list$data$johnny_d,
type = "break_down",
order = c("age", "class", "fare", "gender", "embarked", "sibsp", "parch"),
keep_distributions = TRUE)
plot(bd_rf_johnny_distr, plot_distributions = TRUE) 
3 섀플리 값(Shapley Value)
게임 이론에서 가져온 개념을 기계학습에 적용시킨 것으로 다음과 같이 변수 기여도를 해석할 수 있다. 최적의 변수 조합을 찾는 것이 문제이며 각 변수는 player로 보고 다양한 상호협력 조합을 통해 예측값을 만들어 내느냐는 것이다. 계산량이 많아 다소 불리한 점이 있지만 분해(Break-down) 방법이 갖는 순서 문제(어떤 변수가 먼저 들어가느냐에 따라 해석이 달라지는 문제)와 교호작용(interaction)이 있는 문제점을 해결할 수 있다는 점에서 장점을 갖는다. 또한 새플리 값을 사용하는 경우 가법 모형을 상정하기 때문에 비선형 관계를 갖는 경우 설명에 한계가 존재한다.
3.1 헨리(henry)
3.1.1 표
shap_henry <- predict_parts(explainer = explainer_rf,
new_observation = titanic_list$data$henry,
type = "shap",
B = 5)
shap_henry min q1 median
randomForest: age = 47 -0.207415912 -0.18360781 -0.092601048
randomForest: class = 1st 0.169022392 0.18293030 0.184642878
randomForest: embarked = Cherbourg 0.006984278 0.03316198 0.065780848
randomForest: fare = 25 -0.030378275 -0.00905717 -0.007407813
randomForest: gender = male -0.141802763 -0.13001363 -0.123479371
randomForest: parch = 0 -0.022533587 -0.01166322 -0.010083945
randomForest: sibsp = 0 -0.030329681 -0.01032263 -0.006845831
mean q3 max
randomForest: age = 47 -0.112183516 -0.055628156 -0.023235827
randomForest: class = 1st 0.183760267 0.188121010 0.192613626
randomForest: embarked = Cherbourg 0.074412577 0.124639352 0.141381610
randomForest: fare = 25 -0.006317294 0.004620772 0.008266794
randomForest: gender = male -0.124952072 -0.118171272 -0.112357313
randomForest: parch = 0 -0.010792949 -0.008079323 -0.002455455
randomForest: sibsp = 0 -0.008366270 -0.002457599 0.0063001433.1.2 그래프
library(patchwork)
shap_boxplot_gg <- plot(shap_henry) +
scale_y_continuous(limits =c(-0.3, 0.3))
shap_average_gg <- plot(shap_henry, show_boxplots = FALSE) +
scale_y_continuous(limits =c(-0.3, 0.3))
shap_boxplot_gg / shap_average_gg
데이터 과학자 이광춘 저작
kwangchun.lee.7@gmail.com